home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / music / cdplay.zip / GLOBAL.BAS < prev    next >
BASIC Source File  |  1994-03-31  |  23KB  |  763 lines

  1. Option Explicit
  2. ' Version Number
  3. Global Const MCI_APP_TITLE = "CD Player"
  4. Global Const Version = "Version 1.1"
  5.  
  6. '*** Global Constants ***
  7. Global Const Timer_Interval = 1000
  8. Global Const SecondsPerMinute = 60
  9. Global Const SecondsPerHour = SecondsPerMinute * 60
  10. Global Const SecondsPerDay = SecondsPerHour * 24&
  11.  
  12. '*** Global Variables ***
  13. Global TrackNumChange As Integer
  14. Global CRLF As String
  15. Global Tracks_Loaded As Integer
  16. Global NumOfTracks As Integer
  17. Global TrackIndex As Integer
  18. Global AppPath As String
  19. Global MouseX As Integer
  20. Global MouseY As Integer
  21.  
  22. '*** CD Information ***
  23. Type CD
  24.     CDTitle As String
  25.     ID As Long
  26.     CDAuthor As String
  27.     CDTotalTime As Variant
  28.     CDTrack As Integer
  29. End Type
  30. Global CDTrackNo() As String
  31. Global CDTime() As Variant
  32. Global CDInfo As CD
  33.  
  34. ' These constants are defined in mmsystem.h.
  35. Global Const MCIERR_INVALID_DEVICE_ID = 30257
  36. Global Const MCIERR_DEVICE_OPEN = 30263
  37. Global Const MCIERR_CANNOT_LOAD_DRIVER = 30266
  38. Global Const MCIERR_UNSUPPORTED_FUNCTION = 30274
  39. Global Const MCIERR_INVALID_FILE = 30304
  40. Global Const MCI_NOTIFY_SUCCESSFUL = 1
  41.  
  42. Global Const MCI_MODE_NOT_OPEN = 524
  43. Global Const MCI_MODE_STOP = 525
  44. Global Const MCI_MODE_PLAY = 526
  45. Global Const MCI_MODE_RECORD = 527
  46. Global Const MCI_MODE_SEEK = 528
  47. Global Const MCI_MODE_PAUSE = 529
  48. Global Const MCI_MODE_READY = 530
  49.  
  50. ' Track Information Format
  51. Global Const MCI_FORMAT_MILLISECONDS = 0
  52. Global Const MCI_FORMAT_TMSF = 10
  53.  
  54. ' For Tab Stops in ListBox
  55. Declare Function SendMessage Lib "user" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wp As Integer, lp As Any) As Long
  56. Global Const WM_USER = &H400
  57. Global Const LB_SETTABSTOPS = WM_USER + 19
  58.  
  59. ' SetWindowPOSITION
  60. Declare Function SetWindowPos Lib "User" (ByVal h1%, ByVal h2%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
  61. Global Const HWND_TOPMOST = -1
  62. Global Const HWND_NOTOPMOST = -2
  63. Global Const SWP_NOMOVE = 2
  64. Global Const SWP_NOSIZE = 1
  65. Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
  66.  
  67. ' For creation of New CD Database
  68. Global Const DB_INTEGER = 3
  69. Global Const DB_DOUBLE = 7
  70. Global Const DB_DATE = 8
  71. Global Const DB_TEXT = 10
  72. Global Const DB_LANG_GENERAL = ";LANGID=0x0809;CP=1252;COUNTRY=0"
  73.  
  74. ' Profile String Information
  75. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString$, ByVal nSize%, ByVal lpFileName As String) As Integer
  76. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
  77.  
  78. ' For Floating Titles
  79. Declare Function WindowFromPoint Lib "User" (ByVal X As Integer, ByVal Y As Integer) As Integer
  80.  
  81. Sub AnimateIcon (CDTime As Variant)
  82.     Dim FName As String, Fsize As Integer
  83.     Dim FItalic As Integer
  84.     
  85.     ' Save and Reset Font Options
  86.     FName = CDForm.FontName
  87.     Fsize = CDForm.FontSize
  88.     FItalic = CDForm.FontItalic
  89.     CDForm.FontName = "Modern"
  90.     CDForm.FontSize = 12
  91.     CDForm.FontItalic = False
  92.  
  93.     CDForm.Cls
  94.     CDForm.Line (0, 0)-(510, 310), &H0, BF
  95.     CDForm.DrawWidth = 2
  96.     CDForm.Line (525, 75)-(530, 350)
  97.     CDForm.Line (50, 350)-(525, 350)
  98.     CDForm.DrawWidth = 1
  99.     CDForm.CurrentX = 10
  100.     CDForm.CurrentY = 10
  101.     CDForm.Print CDTime
  102.  
  103.     CDForm.FontName = FName
  104.     CDForm.FontSize = Fsize
  105.     CDForm.FontItalic = FItalic
  106.     
  107. End Sub
  108.  
  109. Function CDExists (CDIDNo As Long) As Integer
  110.     Dim Db As Database
  111.     Dim Tb As Table
  112.  
  113.     Set Db = OpenDatabase(AppPath & "\CDPlayer.MDb")
  114.     Set Tb = Db.OpenTable("Titles")
  115.     Tb.Index = "PrimaryKey"
  116.     Tb.Seek "=", CDIDNo
  117.     If Tb.NoMatch Then
  118.     CDExists = False
  119.     Else
  120.     CDExists = True
  121.     End If
  122.  
  123.  
  124. End Function
  125.  
  126. Sub CenterForm (Center As Form, ShowForm As Integer)
  127.     Load Center
  128.     Center.Top = (Screen.Height - Center.Height) / 2
  129.     Center.Left = (Screen.Width - Center.Width) / 2
  130.     If ShowForm = True Then
  131.     Center.Show
  132.     Center.Refresh
  133.     End If
  134. End Sub
  135.  
  136. Sub CenterLogo (CForm As Form, TheControl As Control)
  137.     CForm.picLogo.Left = (TheControl.Width - CForm.picLogo.Width) / 2
  138. End Sub
  139.  
  140. Sub ChangeMenuStatus (State As Integer)
  141.         CDForm.mnuOptions.Enabled = State
  142.         CDForm.mnuCDInfo.Enabled = State
  143.         CDForm.Status.Caption = "Length: -None- Time: -None-"
  144. End Sub
  145.  
  146. Sub CommitChanges ()
  147.     Dim Db As Database
  148.     Dim DS As Dynaset
  149.     Dim Titles As Dynaset, Tracks As Dynaset
  150.     Dim I As Integer
  151.     
  152.     Set Db = OpenDatabase(AppPath & "\CDPlayer.Mdb")
  153.     Set Titles = Db.CreateDynaset("Titles")
  154.     Set Tracks = Db.CreateDynaset("Tracks")
  155.  
  156.     If CDExists(CDInfo.ID) Then
  157.     Titles.FindFirst "Title_ID = " & CDInfo.ID
  158.     If Titles.NoMatch Then
  159.         MsgBox "Couldn't Find Record!", 0, "Attention!"
  160.         Exit Sub
  161.     End If
  162.     BeginTrans ' Begin a TransAction
  163.     Titles.Edit
  164.     Titles("Title_Name") = CDInfo.CDTitle
  165.     Titles("Title_Artist") = CDInfo.CDAuthor
  166.     
  167.     If CDInfo.CDTotalTime = "" Then CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
  168.     If Len(CDInfo.CDTotalTime) >= 5 Then
  169.         Titles("Title_Length") = TimeValue(("12:" & CDInfo.CDTotalTime))
  170.     Else
  171.         Titles("Title_Length") = TimeValue(CDInfo.CDTotalTime)
  172.     End If
  173.  
  174.     Titles.Update
  175.     CommitTrans
  176.  
  177.     Tracks.Filter = "Title_ID = " & CDInfo.ID
  178.     Set Tracks = Tracks.CreateDynaset()
  179.     BeginTrans
  180.  
  181.     For I = 1 To NumOfTracks
  182.         Tracks.FindFirst "Track_No = " & I
  183.         Tracks.Edit
  184.         Tracks("Track_Title") = Left$(Mid$(CDTrackNo(I), 5, (Len(CDTrackNo(I)) - 5)), 30)
  185.         Tracks("Track_Length") = TimeValue(CDTime(I))
  186.         Tracks.Update
  187.     Next
  188.     CommitTrans
  189.     
  190.     Else
  191.     BeginTrans
  192.     Titles.AddNew
  193.     Titles("Title_ID") = CDInfo.ID
  194.     Titles("Title_Name") = CDInfo.CDTitle
  195.     Titles("Title_Artist") = CDInfo.CDAuthor
  196.  
  197.     If CDInfo.CDTotalTime = "" Then CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
  198.     If Len(CDInfo.CDTotalTime) >= 5 Then
  199.         Titles("Title_Length") = TimeValue(("12:" & CDInfo.CDTotalTime))
  200.     Else
  201.         Titles("Title_Length") = TimeValue(CDInfo.CDTotalTime)
  202.     End If
  203.     
  204.     Titles.Update
  205.  
  206.     For I = 1 To NumOfTracks
  207.         Tracks.AddNew
  208.         Tracks("Title_ID") = CDInfo.ID
  209.         Tracks("Track_No") = I
  210.         Tracks("Track_Title") = Left$(Mid$(CDTrackNo(I), 5, (Len(CDTrackNo(I)) - 5)), 30)
  211.         Tracks("Track_Length") = TimeValue(CDTime(I))
  212.         Tracks.Update
  213.     Next
  214.     CommitTrans
  215.     End If
  216. End Sub
  217.  
  218. Sub CreateCDDatabase ()
  219.     On Error GoTo DB_Problems:
  220.     Dim CDPlayer As Database
  221.     
  222.     ' Titles Table
  223.     Dim NewTitles As New TableDef
  224.     Dim NewTitlesIdx As New Index
  225.     Dim TitlesTitle_ID As New Field
  226.     Dim Title_Name As New Field
  227.     Dim Title_Artist As New Field
  228.     Dim Title_Length As New Field
  229.  
  230.     ' Tracks Table
  231.     Dim NewTracks As New TableDef
  232.     Dim NewTracksIdx As New Index
  233.     Dim TracksTitle_ID As New Field
  234.     Dim Track_No As New Field
  235.     Dim Track_Title As New Field
  236.     Dim Track_Length As New Field
  237.       
  238.     CDForm.frmDisabledCD.Caption = "Creating New CD Database . . ."
  239.     Set CDPlayer = CreateDatabase(AppPath & "\CDPlayer.mdb", DB_LANG_GENERAL)
  240.     
  241.     ' Create Titles Table and Fields
  242.     NewTitles.Name = "Titles"
  243.     TitlesTitle_ID.Name = "Title_ID"
  244.     TitlesTitle_ID.Type = DB_DOUBLE
  245.     Title_Name.Name = "Title_Name"
  246.     Title_Name.Type = DB_TEXT
  247.     Title_Name.Size = 30
  248.     Title_Artist.Name = "Title_Artist"
  249.     Title_Artist.Type = DB_TEXT
  250.     Title_Artist.Size = 30
  251.     Title_Length.Name = "Title_Length"
  252.     Title_Length.Type = DB_DATE
  253.  
  254.     ' Create Tracks Table and Fields
  255.     NewTracks.Name = "Tracks"
  256.     TracksTitle_ID.Name = "Title_ID"
  257.     TracksTitle_ID.Type = DB_DOUBLE
  258.     Track_No.Name = "Track_No"
  259.     Track_No.Type = DB_INTEGER
  260.     Track_Title.Name = "Track_Title"
  261.     Track_Title.Type = DB_TEXT
  262.     Track_Title.Size = 30
  263.     Track_Length.Name = "Track_Length"
  264.     Track_Length.Type = DB_DATE
  265.  
  266.       
  267.     ' Create Indexes
  268.     NewTitlesIdx.Name = "PrimaryKey"
  269.     NewTitlesIdx.Fields = "Title_ID"
  270.     NewTitlesIdx.Primary = True
  271.     NewTitlesIdx.Unique = True
  272.     NewTracksIdx.Name = "PrimaryKey"
  273.     NewTracksIdx.Fields = "Title_ID;Track_No"
  274.     NewTracksIdx.Primary = True
  275.     NewTracksIdx.Unique = True
  276.  
  277.     ' Append New Fields To Titles Table
  278.     NewTitles.Fields.Append TitlesTitle_ID
  279.     NewTitles.Fields.Append Title_Name
  280.     NewTitles.Fields.Append Title_Artist
  281.     NewTitles.Fields.Append Title_Length
  282.     
  283.     ' Append New Fields To Track Table
  284.     NewTracks.Fields.Append TracksTitle_ID
  285.     NewTracks.Fields.Append Track_No
  286.     NewTracks.Fields.Append Track_Title
  287.     NewTracks.Fields.Append Track_Length
  288.  
  289.     ' Append New Indexes
  290.     NewTitles.Indexes.Append NewTitlesIdx
  291.     NewTracks.Indexes.Append NewTracksIdx
  292.     
  293.     ' Append Tables to Database
  294.     CDPlayer.TableDefs.Append NewTitles
  295.     CDPlayer.TableDefs.Append NewTracks
  296.  
  297.     ' Close Everything
  298.     CDPlayer.Close
  299.     Exit Sub
  300.  
  301. DB_Problems:
  302.     Kill AppPath & "\CDPlayer.mdb"
  303.     Resume Next
  304.  
  305. End Sub
  306.  
  307. Sub FloatingTitle ()
  308.     Dim Handle As Integer
  309.     Static X As Integer
  310.     
  311.     X = X + 1
  312.     If X = 3 Then X = 0
  313.     Handle = WindowFromPoint(MouseX, MouseY)
  314.     
  315.     If CDForm.txtFloatTitle.Tag = "" Then Exit Sub
  316.  
  317.     'If CDForm.TrackNum((CInt(CDForm.txtFloatTitle.Tag))).hWnd <> Handle Then
  318.     If X = 2 Then
  319.     CDForm.txtFloatTitle.Visible = False
  320.     End If
  321.  
  322. End Sub
  323.  
  324. Function GetCDID (NumOfTracks As Integer) As Long
  325.     Dim DiskID As Double
  326.     Dim Track As Integer
  327.  
  328.     DiskID = CDForm.MMControl1.Tracks
  329.     For Track = 1 To NumOfTracks
  330.     CDForm.MMControl1.Track = Track
  331.     DiskID = DiskID + CDForm.MMControl1.TrackLength
  332.     DiskID = DiskID + CDForm.MMControl1.Length
  333.     Next Track
  334.     
  335.     GetCDID = DiskID
  336. End Function
  337.  
  338. Sub GetCDInfo ()
  339.     Dim Db As Database
  340.     Dim DS As Dynaset
  341.     Dim I As Integer
  342.     ReDim CDTrackNo(NumOfTracks)
  343.     ReDim CDTime(NumOfTracks)
  344.     On Error GoTo CreateNewCDPlayer:
  345.  
  346.     ' Search for CD Data
  347.     Set Db = OpenDatabase(AppPath & "\CDPlayer.mdb")
  348.     Set DS = Db.CreateDynaset("Select * From Titles, Tracks, Titles INNER JOIN Tracks On Titles.Title_ID = Tracks.Title_ID Where Titles.Title_ID = " & CDInfo.ID)
  349.  
  350.     If DS.BOF = True And DS.EOF = True Then
  351.     CDInfo.CDTitle = "UnTitled"
  352.     CDInfo.CDAuthor = "Unknown"
  353.     CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
  354.     ' Initialize the Array
  355.     UpdateTracks CDForm.MMControl1, False
  356.     I = MsgBox("Would you like to Add this CD to the Database?", 4, "New CD Detected!")
  357.     If I = 6 Then CDEntry.Show 1
  358.     Else
  359.     ' Set up Title Information
  360.     CDInfo.CDTitle = DS("Title_Name")
  361.     CDInfo.CDAuthor = "" & DS("Title_Artist")
  362.     If IsNull(DS("Title_Length")) = False Then
  363.         CDInfo.CDTotalTime = DS("Title_Length")
  364.         If (Left$(CDInfo.CDTotalTime, 2)) = "12" Then
  365.         CDInfo.CDTotalTime = Mid(CDInfo.CDTotalTime, 4, (Len(CDInfo.CDTotalTime) - 3))
  366.         CDInfo.CDTotalTime = Left(CDInfo.CDTotalTime, (Len(CDInfo.CDTotalTime) - 3))
  367.         Else
  368.         CDInfo.CDTotalTime = Left(CDInfo.CDTotalTime, (Len(CDInfo.CDTotalTime) - 3))
  369.         End If
  370.  
  371.     Else
  372.         CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
  373.     End If
  374.  
  375.     ' Set up Track Information
  376.     Do While Not DS.EOF
  377.         I = DS("Track_No")
  378.         CDTrackNo(I) = " - """ & DS("Track_Title") & """"
  379.  
  380.         If DS("Track_Length") = "12:00" Then
  381.         CDTime(I) = Left(DS("Track_Length"), (Len(DS("Track_Length")) - 6))
  382.         Else
  383.         CDTime(I) = GetTrackLength(I)
  384.         End If
  385.         
  386.         DS.MoveNext
  387.     Loop
  388.     End If
  389.     CDForm.Caption = CDInfo.CDTitle
  390.     Exit Sub
  391.  
  392. CreateNewCDPlayer:
  393.     CreateCDDatabase
  394.     Set Db = OpenDatabase(AppPath & "\CDPlayer.mdb")
  395.     Resume Next
  396.  
  397. End Sub
  398.  
  399. Function GetCDLength (NumOfTracks As Integer) As Variant
  400.     Dim Length As Variant
  401.     Dim Tracks As Integer
  402.     Dim CDSeconds As Integer, CDMinutes As Integer
  403.  
  404.     CDSeconds = CDSeconds + (CDForm.MMControl1.Length And &HFF00&) / &H100
  405.     CDMinutes = CDMinutes + (CDForm.MMControl1.Length And &HFF)
  406.  
  407.     Length = DateAdd("s", CDSeconds, Length)
  408.     Length = DateAdd("n", CDMinutes, Length)
  409.     If (Left$(Length, 2)) = "12" Then
  410.     Length = Mid(Length, 4, (Len(Length) - 3))
  411.     GetCDLength = Left(Length, (Len(Length) - 3))
  412.     Else
  413.     GetCDLength = Left(Length, (Len(Length) - 3))
  414.     End If
  415. End Function
  416.  
  417. Function GetCDTime () As String
  418.     Dim CDMinutes As Integer, CDSeconds As Integer
  419.     
  420.     CDMinutes = (CDForm.MMControl1.Position And &HFF00&) \ &H100
  421.     CDSeconds = (CDForm.MMControl1.Position And &HFF0000) \ &H10000
  422.     
  423.     GetCDTime = Format(CStr(CDMinutes & ":" & CDSeconds), "hh:mm")
  424. End Function
  425.  
  426. Function GetCDTrack () As Integer
  427.     ' Get Track Info
  428.     GetCDTrack = (CDForm.MMControl1.Position And &HFF)
  429.  
  430. End Function
  431.  
  432. Sub GetOptionSettings ()
  433.     Dim SectionName As String, TopicName As String
  434.     ReDim Topic(4) As String
  435.     Dim ReturnString As String
  436.     Dim Size As Integer
  437.     Dim INIFileName As String
  438.     Dim ReturnLen As Integer
  439.     Dim I As Integer
  440.  
  441.     SectionName = "OptionSettings"
  442.     ReturnString = Space$(128)
  443.     Size = Len(ReturnString)
  444.     Topic(0) = "Animate"
  445.     Topic(2) = "OnTop"
  446.     Topic(3) = "Float"
  447.     Topic(4) = "Repeat"
  448.  
  449.     ' Name of our INI File
  450.     INIFileName = "CDPlayer.INI"
  451.  
  452.     For I = 0 To 4
  453.     If I = 1 Then I = 2 ' Skip the Option Bar
  454.     TopicName = Topic(I) ' Set up Topic
  455.     
  456.     ' Call API
  457.     ReturnLen = GetPrivateProfileString(SectionName, TopicName, "", ReturnString, Size, INIFileName)
  458.  
  459.     If ReturnLen <> 0 Then
  460.         If I < 4 Then
  461.         '* Discard the trailing spaces and null character.
  462.         CDForm.mnuOptionsItem(I).Checked = Left$(ReturnString, ReturnLen)
  463.         Else
  464.         CDForm.Repeat = Left$(ReturnString, ReturnLen)
  465.         End If
  466.     End If
  467.     Next
  468.     
  469.     If CDForm.mnuOptionsItem(2).Checked Then
  470.     OnTop CDForm
  471.     Else
  472.     OnTop CDForm
  473.     End If
  474.  
  475. End Sub
  476.  
  477. Function GetTrackLength (Track As Integer) As Variant
  478.     Dim CDSeconds As Double, CDMinutes As Double
  479.  
  480.     CDForm.MMControl1.Track = Track
  481.     CDMinutes = CDForm.MMControl1.TrackLength And &HFF
  482.     CDSeconds = (CDForm.MMControl1.TrackLength And &HFF00&) / &H100
  483.     GetTrackLength = CDMinutes & ":" & Format(CDSeconds, "00")
  484.     
  485. End Function
  486.  
  487. Sub InitMMControl ()
  488.     
  489.     ' Initialize Control
  490.     CDForm.frmDisabledCD.Caption = "Initializing The CD Player!"
  491.     
  492.     ' Force the MCI control to complete before returning
  493.     ' to the application.
  494.     CDForm.MMControl1.Wait = False
  495.     CDForm.MMControl1.UpdateInterval = 0
  496.     
  497.     ' Set the DeviceType to a musical CD device.
  498.     CDForm.MMControl1.DeviceType = "CDAudio"
  499.     
  500.     ' Set the time format
  501.     CDForm.MMControl1.TimeFormat = MCI_FORMAT_TMSF
  502.  
  503.     CDForm.MMControl1.NextEnabled = True
  504.     CDForm.MMControl1.PrevEnabled = True
  505.     NumOfTracks = CDForm.MMControl1.Tracks
  506.  
  507.     ' Get Unique CD Identifier
  508.     CDForm.frmDisabledCD.Caption = "Retrieving CD Information. . ."
  509.     CDInfo.ID = GetCDID(NumOfTracks)
  510.     GetCDInfo
  511.     
  512.     ' Find Number of Tracks
  513.     CDForm.frmDisabledCD.Caption = "Loading Track Information. . ."
  514.     Call LoadTracks(NumOfTracks, True)
  515.     
  516.     ' Set Default Button
  517.     CDForm.frmDisabledCD.Caption = "Setting Default Values. . ."
  518.     TrackNumChange = True
  519.     CDForm.TrackNum(1).Value = True
  520.     TrackNumChange = False
  521.  
  522.     ' Get rid of Messagebar
  523.     CDForm.frmDisabledCD.Visible = False
  524.     CDForm.Refresh
  525.     CDForm.frmDisabledCD.Caption = "Please Insert A CD!"
  526.     
  527.     ' Set the track number to the first track.
  528.     CDForm.Status.Caption = "Current Track Length: -None-" & CRLF & "Current Track Time: -None-"
  529.     CDForm.PicTotalTime.Cls
  530.     CDForm.PicTotalTime.Print "    Total Playing Time: " & CDInfo.CDTotalTime
  531.     
  532. End Sub
  533.  
  534. Sub LoadListBox (TheControl As Control)
  535.     Dim I As Integer, RetVal As Long
  536.     Static tabs(1 To 3) As Integer
  537.  
  538.     'Set up the array of defined tab stops.
  539.     tabs(1) = 30
  540.     tabs(2) = 150
  541.     tabs(3) = 200
  542.  
  543.     'Send a message to the message queue.
  544.     RetVal& = SendMessage(TheControl.hWnd, LB_SETTABSTOPS, 3, tabs(1))
  545.  
  546.  
  547.     TheControl.Clear
  548.     For I = 1 To NumOfTracks
  549.     TheControl.AddItem I & ":" & Chr$(9) & (Mid$(CDTrackNo(I), 5, (Len(CDTrackNo(I)) - 5))) & Chr$(9) & CDTime(I)
  550.     Next
  551. End Sub
  552.  
  553. Sub LoadTracks (NumOfCDTracks As Integer, Action As Integer)
  554.     Dim I As Integer
  555.     Dim X As Integer
  556.     Dim FreeSpace As Integer
  557.  
  558.     Select Case Action
  559.     Case -1 ' Load Tracks
  560.         FreeSpace = CDForm.DisplayTracks.Width - (NumOfCDTracks * CDForm.TrackNum(0).Width)
  561.         X = FreeSpace / (NumOfCDTracks + 1)
  562.  
  563.         For I = 1 To NumOfCDTracks
  564.         Load CDForm.TrackNum(I)
  565.         CDForm.TrackNum(I).Top = CDForm.TrackNum(1).Top
  566.         CDForm.TrackNum(I).Left = ((I - 1) * ((CDForm.TrackNum(1).Width) + X)) + X
  567.         CDForm.TrackNum(I).Visible = True
  568.         CDForm.TrackNum(I).ZOrder 0
  569.  
  570.         Load CDForm.TrackLabel(I)
  571.         CDForm.TrackLabel(I).Top = CDForm.TrackLabel(1).Top
  572.         CDForm.TrackLabel(I).Left = ((I - 1) * ((CDForm.TrackNum(1).Width) + X)) + X
  573.         CDForm.TrackLabel(I).Visible = True
  574.         CDForm.TrackLabel(I).ZOrder 0
  575.         CDForm.TrackLabel(I).Caption = I
  576.         CDForm.TrackLabel(I).Width = CDForm.TextWidth(CDForm.TrackLabel(I))
  577.         Next
  578.         Tracks_Loaded = True
  579.     Case 0 ' Unload Tracks
  580.         For I = NumOfCDTracks To 1 Step -1
  581.         Unload CDForm.TrackNum(I)
  582.         Unload CDForm.TrackLabel(I)
  583.         Next
  584.         Tracks_Loaded = False
  585.     
  586.  
  587.     End Select
  588. End Sub
  589.  
  590. Function MMInstalled () As Integer
  591.     Dim Message As String
  592.     
  593.     ' Open the CD device -- the disk must already be
  594.     ' in the drive.
  595.     CDForm.MMControl1.Command = "Open"
  596.     If CDForm.MMControl1.Error = 291 Then ' Another program using!
  597.     Message = "The MCI CD Device is in use by another application.  Wait until it is finished, and then" & CRLF
  598.     Message = Message & "try again!"
  599.     MsgBox Message, 0, "Attention!"
  600.     End
  601.     ElseIf CDForm.MMControl1.Error <> 266 And CDForm.MMControl1.CanPlay = False Then
  602.     Message = "(MCI)CD Audio Driver is not installed!" & CRLF
  603.     Message = Message & "Check the Control Panel Settings Under" & CRLF
  604.     Message = Message & "Drivers for CD Audio Driver installation." & CRLF
  605.     MsgBox Message, 0, "Driver Not Installed!"
  606.     End
  607.     
  608.     ElseIf CDForm.MMControl1.Error = 266 Then ' No CD in Drive
  609.     ChangeMenuStatus False
  610.     CDForm.Timer1.Interval = Timer_Interval
  611.     CDForm.Timer1.Enabled = True
  612.     MMInstalled = False
  613.     Else
  614.     MMInstalled = True
  615.     End If
  616.  
  617.        
  618. End Function
  619.  
  620. Sub OnTop (TopForm As Form)
  621.     Dim RetVal As Integer
  622.     
  623.     CDForm.mnuOptionsItem(2).Checked = Not CDForm.mnuOptionsItem(2).Checked
  624.     If CDForm.mnuOptionsItem(2).Checked Then
  625.     RetVal = SetWindowPos(TopForm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
  626.     Else
  627.     RetVal = SetWindowPos(TopForm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
  628.     End If
  629. End Sub
  630.  
  631. Sub SaveOptionSettings ()
  632.     Dim SectionName As String, TopicName As String
  633.     ReDim Topic(4) As String
  634.     Dim StringValue As String
  635.     Dim INIFileName As String
  636.     Dim ReturnLen As Integer
  637.     Dim I As Integer
  638.  
  639.     SectionName = "OptionSettings"
  640.     Topic(0) = "Animate"
  641.     Topic(2) = "OnTop"
  642.     Topic(3) = "Float"
  643.     Topic(4) = "Repeat"
  644.  
  645.     ' Name of our INI File
  646.     INIFileName = "CDPlayer.INI"
  647.  
  648.     For I = 0 To 4
  649.     If I = 1 Then I = 2 ' Skip the Option Bar
  650.     TopicName = Topic(I) ' Set up Topic
  651.     If I < 4 Then
  652.         StringValue = CStr(CDForm.mnuOptionsItem(I).Checked)
  653.     Else
  654.         StringValue = CStr(CDForm.Repeat.Value)
  655.     End If
  656.     
  657.     ' Call API
  658.     ReturnLen = WritePrivateProfileString(SectionName, TopicName, StringValue, INIFileName)
  659.     Next
  660. End Sub
  661.  
  662. Sub Timer_Control (State As Integer)
  663.     
  664.     CDForm.Timer1.Interval = Timer_Interval
  665.     CDForm.Timer1.Enabled = State
  666.  
  667. End Sub
  668.  
  669. Sub UpdateCaption (TrackNo As Integer, State As String)
  670.     If TrackNo > NumOfTracks Then Exit Sub
  671.     
  672.     If State = "None" Then
  673.     CDForm.Caption = "Please Insert CD!"
  674.     ElseIf CDForm.Caption = CDInfo.CDTitle & CDTrackNo(TrackNo) Then
  675.     Exit Sub
  676.     ElseIf State = "Stopped" Or State = "Paused" Then
  677.     CDForm.Caption = CDInfo.CDTitle & " (" & State & ")"
  678.     Else
  679.     CDForm.Caption = CDInfo.CDTitle & CDTrackNo(TrackNo)
  680.     End If
  681. End Sub
  682.  
  683. Sub UpdateCDInfo (CDTrack As Integer, CDTrackTime As Variant)
  684.     If CDTrack > NumOfTracks Then Exit Sub
  685.     
  686.     ' Update the Track/Time Caption
  687.     CDForm.Status.Caption = "Current Track Length: " & Format(CDTime(CDTrack), "hh:mm") & CRLF & "Current Track Time: " & CDTrackTime
  688.  
  689.     ' Update the Status Bar!
  690.     Call UpdateStatusBar(CDTime(CDTrack), CDTrackTime)
  691.  
  692.    ' Set Current Track
  693.     If CDTrack = 0 Then Exit Sub
  694.     TrackNumChange = True
  695.     CDForm.TrackNum(CDTrack).Value = True
  696.     TrackNumChange = False
  697.     CDForm.TrackPanel3D.Refresh
  698.  
  699.     CDForm.MMControl1.Track = CDTrack
  700.  
  701. End Sub
  702.  
  703. Sub UpdateSeek (TotalTime, MousePos As Single)
  704.     Dim Seconds As Integer, Minutes As Integer
  705.     Dim PercentSeek As Double, TSeconds As Integer
  706.  
  707.     PercentSeek = MousePos / CDForm.CDStatusBar.Width
  708.  
  709.     TSeconds = (Minute(TotalTime) + (Hour(TotalTime) * 60)) * PercentSeek
  710.     Minutes = TSeconds \ 60
  711.     Seconds = TSeconds Mod 60
  712.  
  713.  
  714.     CDForm.MMControl1.To = ((Seconds * 256& * 256&) + (Minutes * 256) + TrackIndex)
  715.     CDForm.MMControl1.Command = "Seek"
  716. End Sub
  717.  
  718. Sub UpdateStatusBar (TotalTime, CurrentTime)
  719.     On Error Resume Next
  720.  
  721.     Dim TotalTimeInt As Double
  722.     Dim CurrentTimeInt As Double
  723.  
  724.     If CurrentTime = "00:00" Then
  725.     CDForm.CDStatusBar.FloodPercent = 0
  726.     Exit Sub
  727.     End If
  728.     
  729.     TotalTimeInt = (Hour(TotalTime) * 60) + (Minute(TotalTime))
  730.     CurrentTimeInt = (Hour(CurrentTime) * 60) + (Minute(CurrentTime))
  731.  
  732.     If CurrentTimeInt <= 1 Then
  733.     CDForm.CDStatusBar.FloodPercent = 0
  734.     ElseIf CurrentTimeInt >= 1 And TotalTimeInt >= CurrentTimeInt Then
  735.     CDForm.CDStatusBar.FloodPercent = Format(((CurrentTimeInt / TotalTimeInt) * 100), "##")
  736.     If CDForm.CDStatusBar.FloodPercent >= 50 Then
  737.         CDForm.CDStatusBar.ForeColor = &HFFFFFF
  738.     ElseIf CDForm.CDStatusBar.FloodPercent <= 50 Then
  739.         CDForm.CDStatusBar.ForeColor = &H0&
  740.     End If
  741.     End If
  742. End Sub
  743.  
  744. Sub UpdateTracks (TheControl As Control, Action As Integer)
  745.     Dim I As Integer
  746.     Dim Title As String
  747.  
  748.     Select Case Action
  749.     Case -1 ' Update
  750.         For I = 0 To TheControl.ListCount - 1
  751.         Title = Mid$(TheControl.List(I), (InStr(TheControl.List(I), Chr$(9)) + 1), (Len(TheControl.List(I)) - (InStr(TheControl.List(I), Chr$(9)))))
  752.         CDTrackNo(I + 1) = " - """ & (Left$(Title, (InStr(Title, Chr$(9)) - 1))) & """"
  753.         Next
  754.     Case 0 ' Reset
  755.         For I = 1 To NumOfTracks
  756.         CDTrackNo(I) = " - ""Track: " & I & """"
  757.         CDTime(I) = GetTrackLength(I)
  758.         Next
  759.     End Select
  760.  
  761. End Sub
  762.  
  763.